﻿#VisualFreeBasic_Form#  Version=5.0.0
Locked=0

[Form]
Name=Form1
ClassStyle=CS_VREDRAW, CS_HREDRAW, CS_DBLCLKS
WinStyle=WS_POPUP, WS_THICKFRAME, WS_CAPTION, WS_SYSMENU, WS_MINIMIZEBOX, WS_MAXIMIZEBOX, WS_CLIPSIBLINGS, WS_CLIPCHILDREN, WS_VISIBLE,WS_EX_WINDOWEDGE, WS_EX_CONTROLPARENT, WS_EX_LEFT, WS_EX_LTRREADING, WS_EX_RIGHTSCROLLBAR
Style=3 - 常规窗口
Icon=hithhicker's.ico
Caption=联网测试
StartPosition=1 - 屏幕中心
WindowState=0 - 正常
Enabled=True
Left=0
Top=0
Width=499
Height=377
Child=False
MdiChild=False
TitleBar=True
SizeBox=True
SysMenu=True
MaximizeBox=True
MinimizeBox=True
Help=False
Hscroll=False
Vscroll=False
MinWidth=300
MinHeight=200
MaxWidth=0
MaxHeight=0
MousePass=False
TransPer=0
TransColor=SYS,25
MousePointer=0 - 默认
BackColor=SYS,15
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False
AcceptFiles=False

[Label]
Name=Label2
Index=-1
Style=0 - 无边框
Caption=网址：
Enabled=True
Visible=True
ForeColor=SYS,8
BackColor=SYS,15
Font=新宋体,9,0
TextAlign=0 - 左对齐
Prefix=True
Ellipsis=False
Left=4
Top=5
Width=39
Height=15
Tag=
ToolTip=
ToolTipBalloon=False

[TextBox]
Name=Text1
Index=-1
Style=3 - 凹边框
TextScrollBars=0 - 无滚动条
Text=https://www.baidu.com/
Enabled=True
Visible=True
MaxLength=0
ForeColor=SYS,8
BackColor=SYS,5
Font=新宋体,9,0
TextAlign=0 - 左对齐
PasswordChar=
Locked=False
HideSelection=False
Multiline=False
Uppercase=False
Lowercase=False
Number=False
Left=42
Top=4
Width=408
Height=20
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False
LeftMargin=0
RightMargin=0
AcceptFiles=False

[Button]
Name=Command1
Index=-1
Caption=Go
Enabled=True
Visible=True
Font=新宋体,9,0
Left=453
Top=2
Width=27
Height=21
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False

[TextBox]
Name=Text2
Index=-1
Style=3 - 凹边框
TextScrollBars=3 - 垂直和水平
Text=eeee
Enabled=True
Visible=True
MaxLength=0
ForeColor=SYS,8
BackColor=SYS,5
Font=新宋体,9,0
TextAlign=0 - 左对齐
PasswordChar=
Locked=False
HideSelection=False
Multiline=True
Uppercase=False
Lowercase=False
Number=False
Left=6
Top=52
Width=471
Height=281
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False
LeftMargin=0
RightMargin=0
AcceptFiles=False

[CheckBox]
Name=Check1
Index=-1
Style=0 - 标准
Caption=UTF8
TextAlign=3 - 中左对齐
Alignment=0 - 文本在左边
Value=0 - 未选择
Multiline=True
Enabled=True
Visible=True
ForeColor=SYS,8
BackColor=SYS,15
Font=新宋体,9,0
Left=9
Top=33
Width=79
Height=14
MousePointer=0 - 默认
Tag=
Tab=True
ToolTip=
ToolTipBalloon=False
AcceptFiles=False


[AllCode]

'--------------------------------------------------------------------------------
Sub Form1_Command1_BN_Clicked(hWndForm As hWnd, hWndControl As hWnd)  '单击

  Dim aa As Long
  Dim hostname As String
  Dim path As String
  Dim ip As UInteger
  Dim s As SOCKET
  Dim sa As sockaddr_in
  Dim sendbuffer As String
  Dim recvbuffer As String
  Dim tob As String
  Dim bytes As Integer
  Dim duiko As Long
  
  '初始化WinSock
  aa = doInit()
  If aa Then
     text2.text = "初始化 WinSock 失败！！" & Str(aa)
      Return
  End If
  
  
  '获取主机名
  'gethostname(@HostName,256)
  'tob="主机名:" & HostName
  
  '获取主机信息
  'sHostEnt=gethostbyname(@HostName)
  
  '检查网址
  tob = Trim( text1.text)
  If Left(LCase(tob), 7) = "http://" Then
      tob = Mid(tob, 8)
      duiko = 80
  ElseIf Left(LCase(tob), 8) = "https://" Then
      tob = Mid(tob, 9)
      duiko = 80
  Else
      duiko = 80
  End If
  Cls
  Print Time & " 端口：" & duiko
  
  getHostAndPath(tob, hostname, path)
  If (Len(hostname) = 0) Then
      text2.text =  "网址无效" & Chr(13, 10)  & text1.text 
      Return
  End If
  Print Time & " 域名：" & hostname
  Print Time & " 路径：" & path
  
  '解决名称
  'Print hostname
  ip = resolveHost(hostname)
  If (ip = 0) Then
      text2.text =  "网址不能转换成IP" & Chr(13, 10)  & hostname
      Return
  End If
  Print Time & " 数字IP：" & ip
  '' 打开 socket
  Print Time & " 打开 socket" & ip
  s = opensocket(AF_INET, SOCK_STREAM, IPPROTO_TCP)
  'af为协议地址族,这里我们使用IPv4,必须为AF_INET
  'type为socket类型,如果使用TCP/IP,type设为SOCK_STREAM,如果使用UDP,则为SOCK_DGRAM
  'protocol在给定的地址族及socket类型有多个入口的情况下用来限定特定的传输,对于TCP其值为IPPROTO_TCP,而UDP则为IPPROTO_UDP
  If (s = 0) Then
      reportError("打开socket")
      Return
  End If
  '' 连接到主机
  sa.sin_port = htons(duiko)
  sa.sin_family = AF_INET
  sa.sin_addr.S_addr = ip
  Print Time & " 连接到主机", ip
  If (connect(s, Cast(PSOCKADDR, @sa), SizeOf(sa)) = SOCKET_ERROR) Then
      reportError("连接到主机connect()")
      closesocket(s) '关闭socket
      Return
  End If
  '' send HTTP 请求
  sendBuffer = "GET /" + path + " HTTP/1.0" + Chr(13, 10) + _
      "Host: " + hostname + Chr(13, 10) + _
      "Connection: close" + Chr(13, 10) + _
      "User-Agent: GetHTTP 0.0" + Chr(13, 10) + _
      Chr(13, 10)
  Print Time & " HTTP 请求:" & sendBuffer
  If (send(s, sendBuffer, Len(sendBuffer), 0) = SOCKET_ERROR) Then
      reportError("HTTP 请求 send()")
      closesocket(s)
      Return
  End If
  
  '' 接收直到连接关闭
  Print Time & " 接收直到连接关闭"
  Dim by(4097) As Byte
  tob = ""
  'recvbuffer=String(4096,0)
  Do
      bytes = recv(s, @by(0), 4096, 0)
      If (bytes <= 0) Then
          Exit Do
      End If
      recvbuffer = String(bytes, 0)
      memcpy SAdd(recvbuffer), @by(0), bytes
      'Peek(String,@by(0))
      tob += Left(recvbuffer, bytes)
      '' 打印缓冲区作为字符串
      'Print *recvbuffer
      
  Loop
  Print Time & "完成"
  If Check1.Value Then
      tob = Utf8toStr(tob)
  End If
  'AfxMsg(Hex(StrPtr(tob)))
  text2.text = tob
  
  shutdown(s, 2) '关闭socket
  closesocket(s) '关闭socket
  WSACleanup '释放
  

End Sub






Sub reportError(ByRef msg As String) '显示错误
  text2.text =  "发生错误：" & msg & Chr(13, 10) & ": error #" & WSAGetLastError()
  
End Sub

Function doInit() As Long  '初始化
  '' init winsock
  Dim wsaData As WSAData
  
  Return WSAStartup(MAKEWORD(1, 1), @wsaData)
  
End Function
Sub getHostAndPath(ByRef src As String, ByRef hostname As String, ByRef path As String)
  '分离网址与路径
  
  Dim p As Integer = InStr(src, "/")
  If p = 0 Then
      hostname = Trim(src)
      path = ""
  Else
      hostname = Trim(Left(src, p -1))
      path = Trim(Mid(src, p + 1))
  End If
End Sub





'======================================================
'======================================================
Function Unicodetoutf8(ByVal Pswzunicode As WString Ptr) As String
  Dim Sutf8 As String
  Sutf8 = String(Len( *Pswzunicode), 0)
  WideCharToMultiByte(Cp_utf8, _                 '设为 Utf-8
      0, _                       '转换类型
      Cast(Lpcwstr, Pswzunicode), _  '原始的unicode字符串
      Len( *Pswzunicode), _       'Unicode 字符串长度
      Cast(Lpstr, StrPtr(Sutf8)), _     'utf-8 字符串
      Len(Sutf8), _              'utf-8长度
      ByVal 0, _
      ByVal 0)
  Function = Sutf8
  
End Function

'Function A2W(ZStrPtr as ZString Ptr, ZStrLen as UInteger = 0) as Any Ptr
'If ZStrPtr Then
'If ZStrLen = 0 Then
'ZStrLen = Strlen(ZStrPtr)
'EndIf
'Dim WStrLen as Integer = MultiByteToWideChar(CP_ACP, 0, ZStrPtr, ZStrLen, Null, 0)
'Dim WStrMem as WString Ptr = xRtl.TempMemory((WStrLen + 1) * SizeOf(WString))
'MultiByteToWideChar(CP_ACP, 0, ZStrPtr, ZStrLen, WStrMem, WStrLen)
'WStrMem[WStrLen] = 0
'Return WStrMem
'EndIf
'End Function

'
'Function W2U(WStrPtr as WString Ptr, WStrLen as UInteger = 0) as Any Ptr
'If WStrPtr Then
'If WStrLen = 0 Then
'WStrLen = wcslen(WStrPtr)
'EndIf
'Dim UTF8Len as Integer = WideCharToMultiByte(CP_UTF8, 0, WStrPtr, WStrLen, Null, 0, Null, Null)
'Dim UTF8Mem as ZString Ptr = xRtl.TempMemory(UTF8Len + 1)
'WideCharToMultiByte(CP_UTF8, 0, WStrPtr, WStrLen, UTF8Mem, UTF8Len, Null, Null)
'UTF8Mem[UTF8Len] = 0
'Return UTF8Mem
'EndIf
'End Function
'
'Function U2W(UTF8Ptr as ZString Ptr,UTF8Len as UInteger = 0) as Any Ptr
'If UTF8Ptr Then
'If UTF8Len = 0 Then
'UTF8Len = Strlen(UTF8Ptr)
'EndIf
'Dim WStrLen as Integer = MultiByteToWideChar(CP_UTF8, 0, UTF8Ptr, UTF8Len, Null, 0)
'Dim WStrMem as WString Ptr = xRtl.TempMemory((WStrLen + 1) * SizeOf(WString))
'MultiByteToWideChar(CP_UTF8, 0, UTF8Ptr, UTF8Len, WStrMem, WStrLen)
'WStrMem[WStrLen] = 0
'Return WStrMem
'EndIf
'End Function
'
'Function A2U(ZStr as ZString Ptr, ZLen as UInteger = 0) as ZString Ptr
'If ZStr Then
'Dim TempMem as Any Ptr = A2W(ZStr, ZLen)
'Return W2U(TempMem, 0)
'EndIf
'End Function
'
'Function U2A(UStr as ZString Ptr,ULen as UInteger = 0) as ZString Ptr
'If UStr Then
'Dim TempMem as Any Ptr = U2W(UStr, ULen)
'Return W2A(TempMem, 0)
'EndIf
'End Function
'
'Function A2W_C(ZStrPtr as ZString Ptr, ZStrLen as UInteger = 0) as Any Ptr
'If ZStrPtr Then
'If ZStrLen = 0 Then
'ZStrLen = Strlen(ZStrPtr)
'EndIf
'Dim WStrLen as Integer = MultiByteToWideChar(CP_ACP, 0, ZStrPtr, ZStrLen, Null, 0)
'Dim WStrMem as WString Ptr = Allocate((WStrLen + 1) * SizeOf(WString))
'MultiByteToWideChar(CP_ACP, 0, ZStrPtr, ZStrLen, WStrMem, WStrLen)
'WStrMem[WStrLen] = 0
'Return WStrMem
'EndIf
'End Function
'
'Function W2A_C(WStrPtr as WString Ptr, WStrLen as UInteger = 0) as Any Ptr
'If WStrPtr Then
'If WStrLen = 0 Then
'WStrLen = wcslen(WStrPtr)
'EndIf
'Dim ZStrLen as Integer = WideCharToMultiByte(CP_ACP, 0, WStrPtr, WStrLen, Null, 0, Null, Null)
'Dim ZStrMem as ZString Ptr = Allocate(ZStrLen + 1)
'WideCharToMultiByte(CP_ACP, 0, WStrPtr, WStrLen, ZStrMem, ZStrLen, Null, Null)
'ZStrMem[ZStrLen] = 0
'Return ZStrMem
'EndIf
'End Function
'
'Function W2U_C(WStrPtr as WString Ptr, WStrLen as UInteger = 0) as Any Ptr
'If WStrPtr Then
'If WStrLen = 0 Then
'WStrLen = wcslen(WStrPtr)
'EndIf
'Dim UTF8Len as Integer = WideCharToMultiByte(CP_UTF8, 0, WStrPtr, WStrLen, Null, 0, Null, Null)
'Dim UTF8Mem as ZString Ptr = Allocate(UTF8Len + 1)
'WideCharToMultiByte(CP_UTF8, 0, WStrPtr, WStrLen, UTF8Mem, UTF8Len, Null, Null)
'UTF8Mem[UTF8Len] = 0
'Return UTF8Mem
'EndIf
'End Function
'
'Function U2W_C(UTF8Ptr as ZString Ptr,UTF8Len as UInteger = 0) as Any Ptr
'If UTF8Ptr Then
'If UTF8Len = 0 Then
'UTF8Len = Strlen(UTF8Ptr)
'EndIf
'Dim WStrLen as Integer = MultiByteToWideChar(CP_UTF8, 0, UTF8Ptr, UTF8Len, Null, 0)
'Dim WStrMem as WString Ptr = Allocate((WStrLen + 1) * SizeOf(WString))
'MultiByteToWideChar(CP_UTF8, 0, UTF8Ptr, UTF8Len, WStrMem, WStrLen)
'WStrMem[WStrLen] = 0
'Return WStrMem
'EndIf
'End Function
'
'Function A2U_C(ZStr as ZString Ptr, ZLen as UInteger = 0) as ZString Ptr
'If ZStr Then
'Dim TempMem as Any Ptr = A2W(ZStr, ZLen)
'Return W2U_C(TempMem, 0)
'EndIf
'End Function
'
'Function U2A_C(UStr as ZString Ptr,ULen as UInteger = 0) as ZString Ptr
'If UStr Then
'Dim TempMem as Any Ptr = U2W(UStr, ULen)
'Return W2A_C(TempMem, 0)
'EndIf
'End Function

